home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
os2
/
lxlt113.zip
/
SOURCES
/
CHCASE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-05-07
|
8KB
|
279 lines
uses os2base, miscUtil, Helpers, strOp, Crt, Dos;
const Version = '1.0.1';
Recurse : boolean = _OFF;
Pause : boolean = _OFF;
Verbose : boolean = _ON;
AssumeYes : boolean = _OFF;
cmBreak = 0;
cmLower = 1;
cmUpper = 2;
cmMixed = 3;
cmAsIs = 4;
var OldExit : Procedure;
fNames : pDarray;
allDone : boolean;
CaseMode : array[1..64] of Byte;
SepString : string[16];
Procedure Stop(eCode : Byte);
begin
case eCode of
1,2 : begin
if eCode = 2
then begin
TextAttr := $0C;
Writeln('├ Invalid switch - see help below for details');
end;
TextAttr := $07;
Writeln('├ Usage: chCase [FileMask1] {...FileMask2} {/CEPSVYH?}');
Writeln('├ /C{#{.}}Convert to [L]ower/[U]pper/[M]ixed/[A]s-is case');
Writeln('├ /E{+|-} r[E]cursive (+) file search through subdirectories');
Writeln('├ /P{+|-} Enable (+) or disable (-) pause before each file');
Writeln('├ /S"{#}" Define separator character(s) OVER old ones');
Writeln('├ /V{+|-} Verbose (show a lot of additional information)');
Writeln('├ /Y{+|-} assume (+) on all queries first available responce');
Writeln('├ /?,/H Show this help screen');
Writeln('├┤Default: /CL /E- /P- /S"." /V+ /Y-');
TextAttr := $08;
Writeln('└┤Example: chCase /cm d:\*.*.txt /e /v-');
end;
end;
Halt(eCode);
end;
Function ParmHandler(var S : string) : Byte;
var I : Longint;
Function Enabled : boolean;
begin
Enabled := _ON;
if length(S) = 1
then exit
else
if (S[2] in ['+','-'])
then ParmHandler := 2
else
if (S[2] in [' ','/'])
then exit
else Stop(2);
if S[2] = '-' then Enabled := _OFF;
end;
begin
ParmHandler := 1;
case upCase(S[1]) of
'?',
'H' : Stop(1);
'C' : begin
I := 1;
repeat
case upCase(S[succ(I)]) of
'L' : CaseMode[I] := cmLower;
'U' : CaseMode[I] := cmUpper;
'M' : CaseMode[I] := cmMixed;
'A' : CaseMode[I] := cmAsIs;
else break;
end;
Inc(I);
until (I >= 64) or (I >= length(S));
CaseMode[I] := cmBreak;
ParmHandler := I;
end;
'E' : Recurse := Enabled;
'P' : Pause := Enabled;
'V' : Verbose := Enabled;
'Y' : AssumeYes := Enabled;
'S' : begin
if (length(S) < 2) or (S[2] <> '"') then Stop(2);
I := 3; SepString := '';
While (I <= length(S)) do
begin
if S[I] = '"' then break;
if First(S[I], SepString) = 0
then SepString := SepString + S[I];
Inc(I);
end;
if S[I] <> '"' then Stop(2);
ParmHandler := I;
end;
else Stop(2);
end;
end;
Function NameHandler(var S : string) : Byte;
var I : Longint;
Quote : boolean;
begin
I := 0;
if S[1] = '"' then begin Quote := _ON; Delete(S, 1, 1); end else Quote := _OFF;
While (I < length(S)) and ((S[succ(I)] > ' ') or Quote) do
if Quote and (S[succ(I)] = '"')
then break
else Inc(I);
fNames^.AddItem(NewStr(Copy(S, 1, I)));
Inc(I, byte(Quote));
NameHandler := I;
end;
Procedure MyExitProc;
begin
Write(#13);
TextAttr := $07; ClrEOL;
OldExit;
end;
Function Ask(const Q,A : string) : byte;
var ch : char;
begin
if AssumeYes then begin Ask := 1; exit; end;
TextAttr := $02;
Write('└ ', Q, ' ');
repeat
ch := upCase(ReadKey);
if First(ch, A) <> 0
then begin
Ask := First(ch, A);
break;
end;
until _OFF;
Writeln(Ch,#13'├');
end;
{Returns: 0 - file is not locked for write}
{ 1 - file is locked and cannot be unlocked}
{ 2 - file has been unlocked}
Function CheckUseCount(fName : string) : byte;
var F : File;
I : Longint;
begin
CheckUseCount := 0;
I := FileMode; FileMode := open_access_ReadWrite or open_share_DenyReadWrite;
Assign(F, fName); SetFattr(F, Archive);
Reset(F, 1); Close(F); FileMode := I;
if ioResult = 0 then exit;
textAttr := $0E;
Writeln(#13'├ The module ' + Copy(fName, 1, 40) + ' is used by another process');
CheckUseCount := 1;
case Ask('[R]eplace, [S]kip or [A]bort?', 'RSA') of
1 : ;
2 : exit;
3 : begin allDone := _ON; exit; end;
end;
fName := fName + #0;
if DosReplaceModule(@fName[1], nil, nil) <> 0
then begin
textAttr := $0C;
Writeln('├ Cannot replace module ' + fName);
exit;
end;
CheckUseCount := 2;
end;
Procedure ProcessFile(fName : string; Attr : Word);
var _d : DirStr;
_n : NameStr;
_e : ExtStr;
dfn : String;
I,cmp : Longint;
begin
fSplit(fName, _d, _n, _e);
_n := _n + _e;
I := 1; cmp := 1; dfn := '';
While I <= length(_n) do
begin
_e := '';
While (i <= length(_n)) and (First(_n[i], SepString) = 0) do
begin _e := _e + _n[i]; Inc(i); end;
case CaseMode[cmp] of
cmLower : lowStr(_e);
cmUpper : upStr(_e);
cmMixed : begin lowStr(_e); _e[1] := upCase(_e[1]); end;
end;
if (CaseMode[cmp] <> cmBreak) and (CaseMode[succ(cmp)] <> cmBreak)
then Inc(cmp);
dfn := dfn + _e;
if i <= length(_n) then begin dfn := dfn + _n[i]; Inc(i); end;
end;
if (Attr and Directory = 0) and (CheckUseCount(fName) = 1) then exit;
textAttr := $0B; ClrEOL; Write('└ ', Copy(_n, 1, 32), ' -> ', Copy(dfn, 1, 32));
if FileRename(_d + _n, _d + dfn)
then if Verbose
then begin
textAttr := $0A; Write(' ok'#13);
textAttr := $0B; Writeln('├');
end
else begin Write(#13); ClrEOL; end
else begin
textAttr := $0C; Write(' error'#13);
textAttr := $0B; Writeln('├');
end;
end;
Procedure ProcessFiles(const fN : string; Level : Longint);
var sr : SearchRec;
_d : DirStr;
_n : NameStr;
_e : ExtStr;
nf : Longint;
begin
fSplit(fN, _d, _n, _e);
FindFirst(fN, Archive or Hidden or SysFile or Directory, sr);
if (DosError <> 0) and (Level = 0) and (not Recurse)
then begin
textAttr := $0C;
Writeln('├ Cannot find such files: ', fN);
end;
nf := 0;
While (DosError = 0) and (not allDone) do
begin
if (sr.Name <> '.') and (sr.Name <> '..')
then begin
if Pause
then case Ask('File ' + sr.Name + ': [P]rocess, [S]kip or [A]bort?', 'PSA') of
2 : sr.Name := '';
3 : begin allDone := _ON; break; end;
end;
if (sr.Name <> '') then ProcessFile(_d + sr.Name, sr.Attr);
end;
FindNext(sr);
end;
FindClose(sr);
if allDone or not Recurse then Exit;
if nf = 0 then begin textAttr := $0B; Write('└ ', _d); ClrEOL; Write(#13); end;
FindFirst(_d + '*.*', Archive or Hidden or SysFile or Directory, sr);
While (dosError = 0) and (not allDone) do
begin
if (sr.Attr and Directory <> 0) and (sr.Name[1] <> '.')
then ProcessFiles(_d + sr.Name + '\' + _n + _e, succ(Level));
FindNext(sr);
end;
FindClose(sr);
end;
var I : Longint;
begin
TextAttr := $0F;
Writeln('┌[ chCase ]──────────────────────────────[ Version '+Version+' ]┐');
Writeln('├ Copyright 1996 by FRIENDS software ─ No rights reserved ┘');
TextAttr := $07;
@OldExit := ExitProc; ExitProc := @MyExitProc;
New(fNames, Init(8));
CaseMode[1] := cmLower;
SepString := '.';
ParseCommandLine(#1, ParmHandler, NameHandler);
if (fNames^.numItems = 0) then Stop(1);
For I := 1 to fNames^.numItems do
begin
ProcessFiles(pString(fNames^.GetItem(I))^, 0);
if allDone then break;
end;
TextAttr := $01; ClrEOL;
Writeln('└┤Done');
end.